home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
pascal
/
tpb4_src.zip
/
KEYSTUFF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-09-13
|
3KB
|
106 lines
{ TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen
Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault
Last modified :: 9-13-88 8:20 pm
}
{$R-} {Range checking off}
{$B-} {Boolean complete evaluation off}
{$S-} {Stack checking off}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
Unit KeyStuff;
Interface
Uses TPcrt;
function StuffKey(St : string) : string;
procedure FlushKey;
{==========================================================================}
Implementation
const
BufSeg = $40;
BufHeadAddr = $1A;
BufTailAddr = $1C;
BufBegAddr = $1E;
BufEndAddr = $3C;
function StuffChar(Ch : Char) : Boolean;
{ This procedure inserts a single character into the keyboard buffer. }
var
Tail, Head : Integer;
NextPos : Integer;
Ch2 : Char;
begin
inline($fa); {disable int's}
Head := MemW[BufSeg:BufHeadAddr]; { get current head of buffer }
Tail := MemW[BufSeg:BufTailAddr]; { get current tail of buffer }
NextPos := Tail+2;
if NextPos > BufEndAddr then
NextPos := BufBegAddr;
if NextPos <> Head then
begin
if Ord(Ch) > $7f then
begin
Ch2 := Chr(Ord(Ch)-$80);
Ch := Chr(0);
end
else
Ch2 := Chr(1);
Mem[BufSeg:Tail] := Ord(Ch); { put character in }
Mem[BufSeg:Tail+1] := Ord(Ch2); { put harmless scan code in }
Tail := NextPos; { increment the tail pointer }
MemW[BufSeg:BufTailAddr] := Tail; { update actual keyboard tail }
inline($fb); { enable int's }
StuffChar := True;
end
else
begin
inline($fb); { enable int's }
StuffChar := False;
end;
end;
function StuffKey(St : string) : string;
{ This procedure inserts a string of characters into the keyboard
buffer, returning either a null string if successful, or a string
containing what wouldn't fit in the buffer. }
var
stuffed : Boolean;
begin
if Length(st) > 0 then
repeat
stuffed := StuffChar(St[1]);
if stuffed then
Delete(st, 1, 1);
until (not stuffed) or (Length(st) < 1);
StuffKey := St;
end;
procedure FlushKey;
{ This procedure removes all characters currently in the keyboard buffer. }
var
TempWord : Word;
begin
while CheckKbd(TempWord) do TempWord := ReadKeyWord
end { FlushKey } ;
end. { UNIT KbdStuff }